VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ErrorMethod"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim vm_Initialized_bln As Boolean

Dim vm_ErrorListeners As ListenerQueue
Dim vm_pParentClass As ErrorClass
Dim vm_pParentHandler As TrappableErrorHandler
Dim vm_pMethodName_str As String

Friend Sub init(methodName As String, _
        ByVal parentClass As ErrorClass, _
        ByVal pr_ParentHandler As TrappableErrorHandler)

vm_pMethodName_str = methodName
Set vm_pParentClass = parentClass
Set vm_pParentHandler = pr_ParentHandler

vm_Initialized_bln = True

pr_ParentHandler.registerErrorMethodByObject Me
addErrorSystemListener pr_ParentHandler

End Sub


Private Sub checkClassInitialization()
checkAndHandleNonInitializationByBoolean vm_Initialized_bln
End Sub

Public Property Get methodName() As String
checkClassInitialization

methodName = vm_pMethodName_str
End Property

Public Property Get parentClass() As ErrorClass
checkClassInitialization

Set parentClass = vm_pParentClass
End Property

Public Property Get parentHandler() As TrappableErrorHandler
checkClassInitialization

Set parentHandler = vm_pParentHandler
End Property

Friend Sub addErrorSystemListener(ByVal newListener As IErrorListener)
checkClassInitialization
checkAndHandleNonInitializedObject newListener

vm_ErrorListeners.enqueueToQueue newListener, qtSystem
End Sub

Public Sub addErrorListener(ByVal listenerToAdd As IErrorListener)
checkClassInitialization
checkAndHandleNonInitializedObject listenerToAdd

vm_ErrorListeners.enqueueToQueue listenerToAdd, qtExternal
End Sub

Public Sub removeErrorListener(ByVal listenerToRemove As IErrorListener)
checkClassInitialization
checkAndHandleNonInitializedObject listenerToRemove

removeandReturnObjectFromStackByObject listenerToRemove, vm_ErrorListeners
End Sub

Public Function hasErrorListenerByObject(ByVal listener As IErrorListener)
checkClassInitialization
checkAndHandleNonInitializedObject listener

hasErrorListenerByObject = objectExistsInStack(vm_ErrorListeners, listener)
End Function


Public Sub registerInternalErrorByObjectAtLine(errObject As errObject, line As Long)
Dim vl_NewError_obj As ErrorNode

checkClassInitialization
checkAndHandleNonInitializedObject errObject

Set vl_NewError_obj = getNewErrorNode
setErrorNodeInternalError vl_NewError_obj, errObject
setErrorNodeLine vl_NewError_obj, line

processError vl_NewError_obj
End Sub

Public Sub registerErrorByDescriptionAtLine(errDescription As String, line As Long)
Dim vl_NewError_obj As ErrorNode

checkClassInitialization
checkAndHandleEmptyString errDescription

Set vl_NewError_obj = getNewErrorNode
setErrorNodeDescription vl_NewError_obj, errDescription
setErrorNodeLine vl_NewError_obj, line

processError vl_NewError_obj
End Sub

Public Sub registerErrorByObject(errObject As errObject)
Dim vl_NewError_obj As ErrorNode

checkClassInitialization
checkAndHandleNonInitializedObject errObject

Set vl_NewError_obj = getNewErrorNode

setErrorNodeInternalError vl_NewError_obj, errObject

processError vl_NewError_obj
End Sub

Public Sub registerErrorByDescription(description As String)
Dim vl_NewError_obj As ErrorNode

checkClassInitialization
checkAndHandleEmptyString description

Set vl_NewError_obj = getNewErrorNode

setErrorNodeDescription vl_NewError_obj, description

processError vl_NewError_obj
End Sub

Private Function getNewErrorNode() As ErrorNode
Dim vl_NewNode As ErrorNode

Set vl_NewNode = New ErrorNode
With vl_NewNode
    Set .faultClass = Me.parentClass
    Set .faultMethod = Me
End With

Set getNewErrorNode = vl_NewNode
End Function

Private Sub setErrorNodeInternalError(ByVal pr_ErrorNode_obj As ErrorNode, ByVal pr_InternalError_obj As errObject)
Set pr_ErrorNode_obj.internalErrorObject = pr_InternalError_obj
End Sub

Private Sub setErrorNodeLine(ByVal pr_ErrorNode_obj As ErrorNode, ByVal pr_line_lng As Long)
pr_ErrorNode_obj.faultLine = pr_line_lng
End Sub

Private Sub setErrorNodeDescription(ByVal pr_ErrorNode_obj As ErrorNode, ByVal pr_description_str As String)
pr_ErrorNode_obj.description = pr_description_str
End Sub


Private Sub processError(ByVal pr_ErrorNode_obj As ErrorNode)
Dim vl_StackIterator As LLIterator

Set vl_StackIterator = vm_ErrorListeners.getIterator
Do While vl_StackIterator.hasCurrent
    vl_StackIterator.currentItem.errorAdded pr_ErrorNode_obj
    vl_StackIterator.moveNext
Loop
End Sub


Private Sub Class_Initialize()
Set vm_ErrorListeners = New ListenerQueue
End Sub

Private Sub Class_Terminate()
Set vm_ErrorListeners = Nothing
End Sub
